home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
pstui100.zip
/
PTUIWIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-20
|
22KB
|
848 lines
{
╔══════════════════╗
║ PTUI Windows ║
║ Include ║
║ Rev. 1.00 ║
╚══════════════════╝
}
Procedure TextWindow.SaveBackground;
Begin
Size:=TextImageSize(X1,Y1,X2+2,Y2+1); {Save the backgound text, shadow}
If Size>MaxAvail Then Error(1);
GetMem(Save,Size);
Mouse.Hide;
GetTextImage(X1,Y1,X2+ShadowXSize,Y2+ShadowYSize,Save);
Mouse.Show;
End;
Procedure TextWindow.DrawWindow;
Begin
VideoColor(BoxFrg,BoxBck); {Redraw the window outline and interior}
Mouse.Hide;
DrawShadowWindow(X1,Y1,X2,Y2,ShdFrg,ShdBck,LineStyle,ShadowStyle);
Mouse.Show;
End;
Procedure TextWindow.Open(NX1,NY1,NX2,NY2:Word;
Forg,Back,ShadForg,ShadBack:Byte;
LStyle:LineStyles;SStyle:ShadowStyles);
Begin
Buttons.Init;
FillChar(VSlide,SizeOf(VSlide),0);
FillChar(HSlide,SizeOf(HSlide),0);
HdrButtonNum :=0;
Header :='';
Card :=PTUIVCRT.Card;
Status :=Visible;
Case SStyle Of
NoShade : Begin
ShadowXSize:=0;
ShadowYSize:=0;
End;
Solid : Begin
ShadowXSize:=1;
ShadowYSize:=1;
End;
LightHash,
MediumHash,
DarkHash : Begin
ShadowXSize:=2;
ShadowYSize:=1;
End;
End;
LineStyle :=LStyle;
ShadowStyle:=SStyle;
BoxFrg :=Forg;
BoxBck :=Back;
ShdFrg :=ShadForg;
ShdBck :=ShadBack;
X1 :=NX1;
Y1 :=NY1;
X2 :=NX2;
Y2 :=NY2;
SaveBackground;
DrawWindow;
End;
Procedure TextWindow.DisplayHeading;
Begin
Mouse.Hide;
If Header='' Then
Begin
VideoColor(BoxFrg,BoxBck); {Blank the heading area}
GotoXY(X1+1,Y1+1);
Pad(X2-X1-1,#32);
End
Else
Begin
VideoColor(HdrFrg,HdrBck);
GotoXY(X1+1,Y1+1);
WriteStr(Header);
End;
Mouse.Show;
End;
Procedure TextWindow.NewHeading(NewHead:String;NewMode:TextFormats;
Forg,Back:Byte);
Begin
HdrFrg:=Forg;
HdrBck:=Back; {Setup the new heading line}
HdrFmt:=NewMode;
If NewHead='' Then
Header:=''
Else
FormatVar(NewHead,Header,X2-X1-1,NewMode);
DisplayHeading;
End;
Procedure TextWindow.Hide;
Var
NewSave :Pointer;
Begin
Status:=Hidden;
If Size>MaxAvail Then Error(1);
GetMem(NewSave,Size);
Mouse.Hide;
GetTextImage(X1,Y1,X2,Y2,NewSave); {Save the window}
PutTextImage(X1,Y1,Save); {Put old text back}
Mouse.Show;
FreeMem(Save,Size);
Save:=NewSave;
End;
Procedure TextWindow.Show;
Var
NewSave :Pointer;
Begin
Status:=Visible;
If Size>MaxAvail Then Error(1);
GetMem(NewSave,Size); {Save the text}
Mouse.Hide;
GetTextImage(X1,Y1,X2+ShadowXSize,Y2+ShadowYSize,NewSave);
PutTextImage(X1,Y1,Save); {Display the window}
FreeMem(Save,Size);
TextBackground(BoxBck);
VideoColor(ShdFrg,ShdBck); {Background Colours may have changed}
DrawShadow(X1,Y1,X2,Y2,ShadowStyle); {Redraw the new shadow}
Mouse.Show;
Save:=NewSave;
End;
Procedure TextWindow.NewPosition(NewX,NewY:Word);
Var
OldX,
OldY :Word;
Begin
OldX:=X1;
OldY:=Y1;
Hide; {Hide the window}
X2:=NewX+(X2-X1);
Y2:=NewY+(Y2-Y1); {Change the position}
X1:=NewX;
Y1:=NewY;
Show; {Redisplay the same window}
Buttons.MoveAll(Integer(X1)-Integer(OldX),Integer(Y1)-Integer(OldY));
If HSlide.MaxPos>0 Then
Begin
HSlide.X1:=HSlide.X1 + Integer(X1) - Integer(OldX);
HSlide.Y1:=HSlide.Y1 + Integer(Y1) - Integer(OldY);
HSlide.X2:=HSlide.X2 + Integer(X1) - Integer(OldX);
HSlide.Y2:=HSlide.Y2 + Integer(Y1) - Integer(OldY);
End;
If VSlide.MaxPos>0 Then
Begin
VSlide.X1:=VSlide.X1 + Integer(X1) - Integer(OldX);
VSlide.Y1:=VSlide.Y1 + Integer(Y1) - Integer(OldY);
VSlide.X2:=VSlide.X2 + Integer(X1) - Integer(OldX);
VSlide.Y2:=VSlide.Y2 + Integer(Y1) - Integer(OldY);
End;
End;
Procedure TextWindow.Drag;
Var
MouseL,
MouseR,
MouseM,
MouseMoved,
MouseRelease :Boolean;
OldMouseX,
OldMouseY,
MouseX,
MouseY,
MouseStartX,
MouseStartY,
MouseDistX,
MouseDistY,
OldX,
OldY :Word;
C :Char;
OldBut :Pointer;
Begin
OldBut:=Buttons.Buttons;
If Mouse.Active Then
Begin
C:=#1;
OldMouseX:=65535;
OldMouseY:=65535;
MouseStartX:=X1-1;
MouseStartY:=Y1-1;
Mouse.SetXY(MouseStartX * MouseGranularity,MouseStartY * MouseGranularity);
End;
MouseRelease:=False;
OldX:=X1;
OldY:=Y1;
Repeat
Repeat
MouseMoved:=False;
KeyBuffer(Clear);
If Mouse.Active Then
Begin
Mouse.GetStatus(MouseX,MouseY,MouseL,MouseR,MouseM);
MouseX:=(MouseX Div MouseGranularity) + 1;
MouseY:=(MouseY Div MouseGranularity) + 1;
If (MouseX<>OldMouseX) Or (MouseY<>OldMouseY) Then MouseMoved:=True;
If (Not MouseL) And (Not MouseR) Then MouseRelease:=True;
End;
Until KeyPressed Or ((MouseMoved Or MouseRelease) And Mouse.Active);
If MouseMoved Then
Begin
If (MouseX+(X2-X1)>VideoCard[Card].XSize-2) Then
OldMouseX:=VideoCard[Card].XSize-2-(X2-X1)
Else
OldMouseX:=MouseX;
If (MouseY+(Y2-Y1)>VideoCard[Card].YSize-1) Then
OldMouseY:=VideoCard[Card].YSize-1-(Y2-Y1)
Else
OldMouseY:=MouseY;
If (OldMouseX<>X1) Or (OldMouseY<>Y1) Then
NewPosition(OldMouseX,OldMouseY);
End
Else
Begin
If KeyPressed Then C:=ReadKey;
If C=#0 Then
Begin
C:=ReadKey;
Case C Of
'K':If X1>4 Then NewPosition(X1-4,Y1);
'M':If X2<VideoCard[Card].XSize-6 Then NewPosition(X1+4,Y1);
'H':If Y1>4 Then NewPosition(X1,Y1-4);
'P':If Y2<VideoCard[Card].YSize-5 Then NewPosition(X1,Y1+4);
End;
End
Else
Case C Of
'4':If X1>1 Then NewPosition(X1-1,Y1);
'6':If X2<VideoCard[Card].XSize-2 Then NewPosition(X1+1,Y1);
'8':If Y1>1 Then NewPosition(X1,Y1-1);
'2':If Y2<VideoCard[Card].YSize-1 Then NewPosition(X1,Y1+1);
End;
End;
Until (C in [#27,#13]) Or (MouseRelease And Mouse.Active);
If (C=#27) Then
NewPosition(OldX,OldY);
Buttons.Buttons:=OldBut;
End;
Procedure TextWindow.DragVertSlideButton;
Var
Dummy,
SlideBarX1,
SlideBarY1,
SlideBarX2,
SlideBarY2,
OldMouseY,
MouseX,
MouseY :Word;
MouseL,
MouseR,
MouseM,
MouseMoved,
MouseRelease :Boolean;
OldSlideBarMx:LongInt;
C :Char;
NewSlide :SlideBarInfo;
Begin
OldSlideBarMx:=VSlide.MaxPos;
C:=#1;
MouseRelease:=False;
VertSlideButtonPos(MouseX,MouseY,Dummy,Dummy);
MouseY:=65535;
Repeat
MouseMoved:=False;
OldMouseY:=MouseY;
KeyBuffer(Clear);
Repeat
If Mouse.Active Then
Begin
Mouse.GetStatus(MouseX,MouseY,MouseL,MouseR,MouseM);
MouseY:=(MouseY Div MouseGranularity) + 1;
If (MouseY<>OldMouseY) Then MouseMoved:=True;
If (Not MouseL) And (Not MouseR) Then MouseRelease:=True;
End;
Until KeyPressed Or MouseMoved Or MouseRelease;
VertSlideBarPos(SlideBarX1,SlideBarY1,SlideBarX2,SlideBarY2);
If KeyPressed Then
Begin
C:=ReadKey;
If C=#0 Then
Begin
C:=ReadKey;
Case C Of
'H':If MouseY>SlideBarY1 Then Dec(MouseY,1);
'I':If MouseY>SlideBarY1+9 Then Dec(MouseY,10);
'P':I